home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / OOPTUT34.ZIP / FIGURES.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-11  |  5KB  |  198 lines

  1.  
  2. { Turbo Figures }
  3. { Copyright (c) 1989,90 by Borland International, Inc. }
  4.  
  5. unit Figures;
  6. { From Chapter 4 the Turbo Pascal 6.0 User's Guide.
  7.   Virtual methods & polymorphic objects.
  8. }
  9.  
  10. interface
  11.  
  12. uses Graph, Crt;
  13.  
  14. type
  15.   Location = object
  16.     X,Y: Integer;
  17.     procedure Init(InitX, InitY: Integer);
  18.     function GetX: Integer;
  19.     function GetY: Integer;
  20.   end;
  21.  
  22.   PointPtr = ^Point;
  23.  
  24.   Point = object (Location)
  25.     Visible: Boolean;
  26.     constructor Init(InitX, InitY: Integer);
  27.     destructor Done; virtual;
  28.     procedure Show; virtual;
  29.     procedure Hide; virtual;
  30.     function IsVisible: Boolean;
  31.     procedure MoveTo(NewX, NewY: Integer);
  32.     procedure Drag(DragBy: Integer); virtual;
  33.   end;
  34.  
  35.   CirclePtr = ^Circle;
  36.  
  37.   Circle = object (Point)
  38.     Radius: Integer;
  39.     constructor Init(InitX, InitY: Integer; InitRadius: Integer);
  40.     procedure Show; virtual;
  41.     procedure Hide; virtual;
  42.     procedure Expand(ExpandBy: Integer); virtual;
  43.     procedure Contract(ContractBy: Integer); virtual;
  44.   end;
  45.  
  46. implementation
  47.  
  48. {--------------------------------------------------------}
  49. { Location's method implementations:                     }
  50. {--------------------------------------------------------}
  51.  
  52. procedure Location.Init(InitX, InitY: Integer);
  53.  
  54. begin
  55.   X := InitX;
  56.   Y := InitY;
  57. end;
  58.  
  59. function Location.GetX: Integer;
  60. begin
  61.   GetX := X;
  62. end;
  63.  
  64. function Location.GetY: Integer;
  65. begin
  66.   GetY := Y;
  67. end;
  68.  
  69.  
  70. {--------------------------------------------------------}
  71. { Points's method implementations:                       }
  72. {--------------------------------------------------------}
  73.  
  74. constructor Point.Init(InitX, InitY: Integer);
  75. begin
  76.   Location.Init(InitX, InitY);
  77.   Visible := False;
  78. end;
  79.  
  80. destructor Point.Done;
  81. begin
  82.   Hide;
  83. end;
  84.  
  85. procedure Point.Show;
  86. begin
  87.   Visible := True;
  88.   PutPixel(X, Y, GetColor);
  89. end;
  90.  
  91. procedure Point.Hide;
  92. begin
  93.   Visible := False;
  94.   PutPixel(X, Y, GetBkColor);
  95. end;
  96.  
  97. function Point.IsVisible: Boolean;
  98. begin
  99.   IsVisible := Visible;
  100. end;
  101.  
  102. procedure Point.MoveTo(NewX, NewY: Integer);
  103. begin
  104.   Hide;
  105.   X := NewX;
  106.   Y := NewY;
  107.   Show;
  108. end;
  109.  
  110. function GetDelta(var DeltaX: Integer; var DeltaY: Integer): Boolean;
  111. var
  112.   KeyChar: Char;
  113.   Quit: Boolean;
  114. begin
  115.   DeltaX := 0; DeltaY := 0;      { 0 means no change in position;  }
  116.   GetDelta := True;              { True means we return a delta    }
  117.   repeat
  118.     KeyChar := ReadKey;          { First, read the keystroke }
  119.     Quit := True;                { Assume it's a useable key }
  120.     case Ord(KeyChar) of
  121.        0: begin                  { 0 means an extended, 2-byte code }
  122.             KeyChar := ReadKey;  { Read second byte of code }
  123.             case Ord(KeyChar) of
  124.              72: DeltaY := -1;   { Up arrow; decrement Y }
  125.              80: DeltaY := 1;    { Down arrow; increment Y }
  126.              75: DeltaX := -1;   { Left arrow; decrement X }
  127.              77: DeltaX := 1;    { Right arrow; increment X }
  128.              else Quit := False; { Ignore any other code }
  129.             end; { case }
  130.           end;
  131.       13: GetDelta := False;     { CR pressed means no delta  }
  132.     else Quit := False;          { Ignore any other keystroke }
  133.     end;  { case }
  134.   until Quit;
  135. end;
  136.  
  137. procedure Point.Drag(DragBy: Integer);
  138. var
  139.   DeltaX, DeltaY: Integer;
  140.   FigureX, FigureY: Integer;
  141. begin
  142.   Show;                          { Display figure to be dragged }
  143.   FigureX := GetX;               { Get the initial position of figure }
  144.   FigureY := GetY;
  145.  
  146.   { This is the drag loop: }
  147.   while GetDelta(DeltaX, DeltaY) do
  148.   begin                          { Apply delta to figure X,Y: }
  149.     FigureX := FigureX + (DeltaX * DragBy);
  150.     FigureY := FigureY + (DeltaY * DragBy);
  151.     MoveTo(FigureX, FigureY);    { And tell the figure to move }
  152.   end;
  153. end;
  154.  
  155. {--------------------------------------------------------}
  156. { Circle's method implementations:                       }
  157. {--------------------------------------------------------}
  158.  
  159. constructor Circle.Init(InitX, InitY: Integer; InitRadius: Integer);
  160. begin
  161.   Point.Init(InitX, InitY);
  162.   Radius := InitRadius;
  163. end;
  164.  
  165. procedure Circle.Show;
  166. begin
  167.   Visible := True;
  168.   Graph.Circle(X, Y, Radius);
  169. end;
  170.  
  171. procedure Circle.Hide;
  172. var
  173.   TempColor: Word;
  174. begin
  175.   TempColor := Graph.GetColor;
  176.   Graph.SetColor(GetBkColor);
  177.   Visible := False;
  178.   Graph.Circle(X, Y, Radius);
  179.   Graph.SetColor(TempColor);
  180. end;
  181.  
  182. procedure Circle.Expand(ExpandBy: Integer);
  183. begin
  184.   Hide;
  185.   Radius := Radius + ExpandBy;
  186.   if Radius < 0 then Radius := 0;
  187.   Show;
  188. end;
  189.  
  190. procedure Circle.Contract(ContractBy: Integer);
  191. begin
  192.   Expand(-ContractBy);
  193. end;
  194.  
  195. { No initialization section }
  196.  
  197. end.
  198.